DM 2 - Eva Racine - Isabelle Lignières

Eva Racine et Isabelle Lignières

Devoir II - Etude de table de mortalité

Importation des données :

Mise en place des paramètres et des packages :

Nous avons eu un message d’erreur de ” Error in draw_axis(break_positions = guide$key[[aesthetic]], break_labels = guide$key$.label, : lazy-load database ‘/Library/Frameworks/R.framework/Versions/4.2/Resources/library/gtable/R/gtable.rdb’ is corrupt “. C’est un problème avec le package. En lancant ce code, le problème s’est résolu :

#install.packages('gtable')

params = list(
  truc= "Science des Données",
  year= 2023 ,
  country_code= 'fr_t',
  country= 'France',
  datafile= 'full_life_table.Rds',
  year_p= 1948,
  year_e= 2017
)

require(patchwork)

Loading required package: patchwork

require(glue)

Loading required package: glue

require(here)

Loading required package: here

here() starts at /Users/evaracine/FAC/L3/S6/SCIENCES DES DONNÉES

require(tidyverse)

Loading required package: tidyverse

── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ dplyr     1.1.4     ✔ readr     2.1.4
✔ forcats   1.0.0     ✔ stringr   1.5.1
✔ ggplot2   3.4.4     ✔ tibble    3.2.1
✔ lubridate 1.9.3     ✔ tidyr     1.3.0
✔ purrr     1.0.2     
── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()
ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

require(plotly)

Loading required package: plotly

Attaching package: 'plotly'

The following object is masked from 'package:ggplot2':

    last_plot

The following object is masked from 'package:stats':

    filter

The following object is masked from 'package:graphics':

    layout

require(DT)

Loading required package: DT

require(ggforce)

Loading required package: ggforce

install.packages("demography", repos = "https://cran.r-project.org")

The downloaded binary packages are in
    /var/folders/_7/vlg1zj650wzfbmjfd6lg1f480000gn/T//RtmpmJzJR7/downloaded_packages

old_theme <-theme_set(theme_minimal(base_size=9, base_family = "Helvetica"))

Importation de la table de données :

datafile <- 'full_life_table.Rds'
fpath <- stringr::str_c("./DATA/", datafile)
# here::here('DATA', datafile)
# check getwd() if problem
if (! file.exists(fpath)) {
  download.file("https://stephane-v-boucheron.fr/data/full_life_table.Rds",
                fpath,
                mode="wb")
}
life_table <- readr::read_rds(fpath)

life_table <- life_table %>%
  mutate(Country = as_factor(Country)) %>%
  mutate(Country = fct_relevel(Country, "Spain", "Italy", "France",
  "England & Wales", "Netherlands", "Sweden", "USA")) %>%
  mutate(Gender = as_factor(Gender))
life_table <- life_table %>%
  mutate(Area = fct_collapse(Country,
                        SE = c("Spain", "Italy", "France"),
                        NE = c("England & Wales", "Netherlands", "Sweden"),
                        USA="USA"))

life_table

# A tibble: 379,170 × 13
    Year   Age      mx      qx    ax     lx    dx    Lx      Tx    ex Country
   <int> <int>   <dbl>   <dbl> <dbl>  <int> <int> <int>   <int> <dbl> <fct>  
 1  1816     0 0.205   0.180    0.31 100000 17972 87524 4009912  40.1 France 
 2  1816     1 0.0467  0.0456   0.5   82028  3742 80156 3922388  47.8 France 
 3  1816     2 0.0341  0.0336   0.5   78285  2626 76972 3842232  49.1 France 
 4  1816     3 0.0230  0.0228   0.5   75659  1723 74798 3765260  49.8 France 
 5  1816     4 0.0160  0.0159   0.5   73936  1176 73348 3690462  49.9 France 
 6  1816     5 0.0137  0.0136   0.5   72760   992 72264 3617114  49.7 France 
 7  1816     6 0.0119  0.0118   0.5   71768   846 71344 3544850  49.4 France 
 8  1816     7 0.0102  0.0101   0.5   70921   717 70563 3473506  49.0 France 
 9  1816     8 0.00864 0.0086   0.5   70204   604 69902 3402943  48.5 France 
10  1816     9 0.00734 0.00732  0.5   69601   509 69346 3333041  47.9 France 
# ℹ 379,160 more rows
# ℹ 2 more variables: Gender <fct>, Area <fct>

Question 1 :

On filtre d’abord la base de données pour garder les années de 1900 à 1913. De plus, la question nous demande une illustration pour chaque sexe. On va donc garder uniquement “Female” et “Male” et supprimer “Both” qui regroupe les deux car cela ne nous servira pas ici :

life_table_1900a1913 <- life_table |> filter(Year>=1900 & Year<=1913) |> subset(Gender=="Male" | Gender=="Female") |> group_by(Country, Gender)

life_table_1900a1913

# A tibble: 16,720 × 13
# Groups:   Country, Gender [12]
    Year   Age      mx      qx    ax     lx    dx    Lx      Tx    ex Country
   <int> <int>   <dbl>   <dbl> <dbl>  <int> <int> <int>   <int> <dbl> <fct>  
 1  1900     0 0.166   0.149    0.31 100000 14934 89757 4695469  47.0 France 
 2  1900     1 0.0333  0.0328   0.5   85066  2789 83671 4605712  54.1 France 
 3  1900     2 0.018   0.0178   0.5   82277  1467 81543 4522041  55.0 France 
 4  1900     3 0.0117  0.0116   0.5   80809   938 80340 4440498  55.0 France 
 5  1900     4 0.00925 0.0092   0.5   79871   735 79504 4360158  54.6 France 
 6  1900     5 0.00651 0.00649  0.5   79136   513 78879 4280654  54.1 France 
 7  1900     6 0.00559 0.00557  0.5   78622   438 78403 4201775  53.4 France 
 8  1900     7 0.00475 0.00474  0.5   78184   371 77999 4123372  52.7 France 
 9  1900     8 0.0043  0.00429  0.5   77813   334 77646 4045373  52.0 France 
10  1900     9 0.00386 0.00385  0.5   77479   298 77330 3967727  51.2 France 
# ℹ 16,710 more rows
# ℹ 2 more variables: Gender <fct>, Area <fct>

Ensuite, on illustre pour chaque pays et chaque sexe, l’évolution des quotients de mortalité.

On étudie donc le quotient de mortalité correspondant à la colonne “qx” qui représente le risque de mortalité à l’âge x.

On remarque qu’on peut étudier qx comme une fonction de l’année t, mais aussi pour une année donnée, étudier qx comme une fonction de l’âge x (cf. sujet Devoir 2). On va donc représenter ces deux manières.

Evolution des quotients de mortalité en fonction de l’âge pour une année t fixée entre 1900 et 1913 :

proto_plt2 <-
  ggplot() +
  aes(x=Age, y=qx, colour=Country, frame=Year, linetype=Country) +
  theme(plot.title = element_text(size = 12, face = "bold", hjust = 0.5)) +
  geom_point(size=.1) +
  geom_line(size=.1) +
  scale_y_log10() +
  labs(linetype=c("Country")) +
  scale_x_continuous(breaks = c(seq(0, 100, 10), 109)) +
  xlab("Age") +
  ylab("Central death rates") +
  facet_grid(cols=vars(Gender))

Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
ℹ Please use `linewidth` instead.

with(params,
(proto_plt2 %+%
  (life_table_1900a1913)  +
  ggtitle("Evolution des quotients de mortalité entre 1900 et 1913 en fonction de l'âge\n pour une année donnée"))) %>%
  plotly::ggplotly()

Warning in p$x$data[firstFrame] <- p$x$frames[[1]]$data: number of items to
replace is not a multiple of replacement length

Evolution des quotients de mortalité en fonction des années entre 1900 et 1913 pour un âge x fixé :

proto_plt3 <-
  ggplot() +
  aes(x=Year, y=qx, colour=Country, frame=Age, linetype=Country) +
  theme(plot.title = element_text(size = 12, face = "bold", hjust = 0.5)) +
  geom_point(size=.5) +
  geom_line(size=.1) +
  scale_y_log10() +
  labs(linetype=c("Country")) +
  scale_x_continuous(breaks = c(seq(1900, 1913, 3))) +
  xlab("Year") +
  ylab("Central death rates") +
  facet_grid(cols=vars(Gender))

with(params,
(proto_plt3 %+%
  (life_table_1900a1913)  +
  ggtitle("Evolution des quotients de mortalité entre 1900 et 1913 pour un âge donné"))) %>%
  plotly::ggplotly()

Commentaire :

Nous n’avons pas de données avant 1908 pour l’Espagne. Les courbes de l’Espagne se démarquent dans les deux graphes par de fortes fluctuations. Ceci peut être expliqué par des facteurs historiques (“el retraso” espagnol) ou par le manque de données puisqu’elles ne datent que de 1908.

Premier graphique : Nous avons une forme de courbe en V que nous retrouvons au cours des 13 années avec un minimum à 10 ans. Pour la partie décroissante entre 0 et 10 ans, le risque de mourir chute ce qui est notamment dû aux nombreux riques liés à l’accouchement et la grossesse (morts-nés comptabilisé). Pour la croissance entre 10 et 109 ans, le risque de mourir à l’âge x augmente. Plus les personnes vieillissent, plus elles risquent de mourir.

Deuxième graphique : Les courbes décroissent légèrement entre 1900 et 1913. Le risque de mourir à un âge x diminue au fil des ans. La décroissance est plus nette pour les âges compris entre 0 et 13 ans.

Question 2 :

Régression linéaire du logarithme du quotient de mortalité entre 1900 et 1913 :

On cherche à effectuer pour chaque pays, chaque sexe et chaque année entre 1900 et 1913 une régression linéaire du logarithme du quotient de mortalité en fonction de l’âge, pour des âges compris entre 30 et 70 ans.

Premièrement, on va filtrer la base de données pour selectionner ce qui nous intéresse. On peut reprendre la base de données filtrée précédente qui prend les données entre 1900 et 1913. A cela, on selectionne uniquement les âges entre 30 et 70 ans, et on ajoute une colonne qui représente le logarithme du quotient de mortalité qx.

life_table_1900_1913_3070 <- life_table_1900a1913 |> filter(Age<=70 & Age>=30) |> mutate(logqx = log(qx)) |> group_by(Country, Gender)

life_table_1900_1913_3070

# A tibble: 6,232 × 14
# Groups:   Country, Gender [12]
    Year   Age      mx      qx    ax    lx    dx    Lx      Tx    ex Country
   <int> <int>   <dbl>   <dbl> <dbl> <int> <int> <int>   <int> <dbl> <fct>  
 1  1900    30 0.00814 0.00811   0.5 68372   555 68095 2423117  35.4 France 
 2  1900    31 0.00817 0.00814   0.5 67818   552 67542 2355022  34.7 France 
 3  1900    32 0.00856 0.00852   0.5 67266   573 66979 2287481  34.0 France 
 4  1900    33 0.00865 0.00861   0.5 66692   574 66405 2220502  33.3 France 
 5  1900    34 0.00828 0.00825   0.5 66118   545 65845 2154097  32.6 France 
 6  1900    35 0.0088  0.00877   0.5 65572   575 65285 2088251  31.8 France 
 7  1900    36 0.00898 0.00894   0.5 64998   581 64707 2022966  31.1 France 
 8  1900    37 0.0089  0.00886   0.5 64416   571 64131 1958259  30.4 France 
 9  1900    38 0.00913 0.00909   0.5 63845   580 63555 1894129  29.7 France 
10  1900    39 0.00929 0.00924   0.5 63265   585 62973 1830573  28.9 France 
# ℹ 6,222 more rows
# ℹ 3 more variables: Gender <fct>, Area <fct>, logqx <dbl>

On peut par la suite illustrer la régression linéaire. On crée le même modèle de graphique que précédemment. La régression linéaire simple pour chaque pays, chaque sexe et chaque année se fera grâce à geom_smooth(method=“lm”, se=FALSE). En effet, lm est la fonction de R pour la régression.

graph_reglin_0013 <-
  ggplot() +
  aes(x=Age, y=logqx, colour=Country, frame=Year)+
  theme(plot.title = element_text(size = 12, face = "bold", hjust = 0.5)) +
  geom_smooth(method="lm", se=FALSE)+
  geom_point(size=.3) +
  geom_line(size=.1) +
  labs(linetype=c("Country")) +
  scale_x_continuous(breaks = c(seq(30, 70, 10), 70)) +
  xlab("Age") +
  ylab("logarithme du quotient de mortalité") +
  facet_grid(cols=vars(Gender))

with(params,
(graph_reglin_0013 %+%
  (life_table_1900_1913_3070)  +
  ggtitle("Régression linéaire du logarithme du quotient de mortalité en fonction de l'âge"))) %>%
  plotly::ggplotly()

`geom_smooth()` using formula = 'y ~ x'

Warning in p$x$data[firstFrame] <- p$x$frames[[1]]$data: number of items to
replace is not a multiple of replacement length

Les données se superposent mais on peut les isoler.

Régression linéaire du logarithme du quotient de mortalité entre 1921 et 1925 :

On filtre la base de données.

life_table_1921_1925_3070 <- life_table |> filter(Year>=1921 & Year<=1925, Age<=70 & Age>=30, Gender!="Both") |> mutate(logqx = log(qx)) |> group_by(Country, Gender)

life_table_1921_1925_3070

# A tibble: 2,460 × 14
# Groups:   Country, Gender [12]
    Year   Age      mx      qx    ax    lx    dx    Lx      Tx    ex Country
   <int> <int>   <dbl>   <dbl> <dbl> <int> <int> <int>   <int> <dbl> <fct>  
 1  1921    30 0.00599 0.00597   0.5 77095   460 76864 2982817  38.7 France 
 2  1921    31 0.00588 0.00586   0.5 76634   449 76410 2905953  37.9 France 
 3  1921    32 0.00606 0.00604   0.5 76185   460 75955 2829543  37.1 France 
 4  1921    33 0.006   0.00598   0.5 75725   453 75499 2753588  36.4 France 
 5  1921    34 0.00624 0.00622   0.5 75272   468 75038 2678089  35.6 France 
 6  1921    35 0.00641 0.00638   0.5 74804   478 74565 2603051  34.8 France 
 7  1921    36 0.00642 0.0064    0.5 74327   476 74089 2528486  34.0 France 
 8  1921    37 0.0068  0.00677   0.5 73851   500 73601 2454397  33.2 France 
 9  1921    38 0.00689 0.00686   0.5 73351   503 73099 2380796  32.5 France 
10  1921    39 0.00676 0.00674   0.5 72848   491 72602 2307697  31.7 France 
# ℹ 2,450 more rows
# ℹ 3 more variables: Gender <fct>, Area <fct>, logqx <dbl>

On peut par la suite illustrer la régression linéaire. On crée le même modèle de graphique que précédemment. La régression linéaire simple pour chaque pays, chaque sexe et chaque année se fera grâce à geom_smooth(method=“lm”, se=FALSE). En effet, lm est la fonction de R pour la régression. C’est en fait la même chose que pour 1900 à 1913.

graph_reglin_2125 <-
  ggplot() +
  aes(x=Age, y=logqx, colour=Country, frame=Year)+
  theme(plot.title = element_text(size = 12, face = "bold", hjust = 0.5)) +
  geom_smooth(method="lm", se=FALSE)+
  geom_point(size=.3) +
  geom_line(size=.1) +
  labs(linetype=c("Country")) +
  scale_x_continuous(breaks = c(seq(30, 70, 10), 70)) +
  xlab("Age") +
  ylab("logarithme du quotient de mortalité") +
  facet_grid(cols=vars(Gender))

with(params,
(graph_reglin_2125 %+%
  (life_table_1921_1925_3070)  +
  ggtitle("Régression linéaire du logarithme du quotient de mortalité en fonction de l'âge"))) %>%
  plotly::ggplotly()

`geom_smooth()` using formula = 'y ~ x'

Commentaire :

La régression linéaire nous permet de remarquer que le quotient de mortalité est croissant entre 30 et 70 ans. Le risque de mourir à l’âge x croît lorsque x (l’âge) croît. Le logarithme du quotient de mortalité varie entre -6 et -3 car le quotient de mortalité varie entre 0,01 et 0,04 des nombres compris entre 0 et 1 donc le logarithme est négatif.

Question 3 :

Il faut illustrer la différence entre les quotients de mortalité tirés des tables du moment de l’année 1890 et les quotient de mortalité effectivement subis entre 1890 et 1980. Pour cela on va créer deux tables (la table du moment de 1890 et la table de génération) et les joindre.

Ensuite, on pourra comparer les deux quotients de mortalité : celui du moment pendant l’année de naissance et celui réel.

Table du moment de 1890 :

La table du moment est la table qui contient pour chaque année les risques de mortalité à différents âge pour la même année. Ainsi, la table du moment de 1890 ci-dessous nous donne tous les quotients de mortalité pour chaque âge en 1890 (pour chaque pays et chaque sexe). On s’arrête à 90 ans car la question se pose de 1890 à 1980, soit 90 ans.

moment_1890 <- life_table |> filter(Year==1890, Age<=90) |> group_by(Country, Gender)

moment_1890

# A tibble: 1,365 × 13
# Groups:   Country, Gender [15]
    Year   Age      mx      qx    ax     lx    dx    Lx      Tx    ex Country
   <int> <int>   <dbl>   <dbl> <dbl>  <int> <int> <int>   <int> <dbl> <fct>  
 1  1890     0 0.180   0.160    0.31 100000 15993 88898 4343367  43.4 France 
 2  1890     1 0.0551  0.0536   0.5   84007  4503 81755 4254469  50.6 France 
 3  1890     2 0.027   0.0266   0.5   79503  2118 78444 4172714  52.5 France 
 4  1890     3 0.0177  0.0176   0.5   77385  1360 76705 4094270  52.9 France 
 5  1890     4 0.0129  0.0128   0.5   76025   975 75538 4017565  52.8 France 
 6  1890     5 0.00947 0.00942  0.5   75050   707 74697 3942027  52.5 France 
 7  1890     6 0.00694 0.00692  0.5   74343   514 74086 3867330  52.0 France 
 8  1890     7 0.00505 0.00504  0.5   73829   372 73643 3793244  51.4 France 
 9  1890     8 0.0038  0.0038   0.5   73457   279 73318 3719601  50.6 France 
10  1890     9 0.00319 0.00319  0.5   73178   233 73062 3646283  49.8 France 
# ℹ 1,355 more rows
# ℹ 2 more variables: Gender <fct>, Area <fct>

Table de génération :

La table de génération est comme une suite. On suit la cohorte des individus nés en 1890 jusqu’en 1980. C’est à dire qu’on regarde les quotients de mortalité à la naissance en 1890, puis les quotients de mortalité à un an en 1891, etc… jusqu’au quotient à l’âge de 90 ans en 1980.

cohorte_1890 <-data.frame()
for(i in 0:90) {
  cohorte_1890 <- cohorte_1890 |> rbind(life_table|> filter(Age==i & Year==(1890+i)))
}
cohorte_1890

# A tibble: 1,728 × 13
    Year   Age    mx    qx    ax     lx    dx    Lx      Tx    ex Country Gender
   <int> <int> <dbl> <dbl> <dbl>  <int> <int> <int>   <int> <dbl> <fct>   <fct> 
 1  1890     0 0.180 0.160  0.31 100000 15993 88898 4343367  43.4 France  Both  
 2  1890     0 0.162 0.146  0.31 100000 14618 89974 4483572  44.8 France  Female
 3  1890     0 0.197 0.173  0.3  100000 17298 87877 4210587  42.1 France  Male  
 4  1890     0 0.162 0.145  0.31 100000 14543 89904 4471978  44.7 Englan… Both  
 5  1890     0 0.145 0.132  0.31 100000 13185 90957 4652857  46.5 Englan… Female
 6  1890     0 0.178 0.158  0.3  100000 15845 88895 4295384  43.0 Englan… Male  
 7  1890     0 0.208 0.182  0.31 100000 18183 87377 4441719  44.4 Nether… Both  
 8  1890     0 0.187 0.166  0.31 100000 16562 88640 4576372  45.8 Nether… Female
 9  1890     0 0.229 0.197  0.3  100000 19710 86186 4312684  43.1 Nether… Male  
10  1890     0 0.218 0.189  0.31 100000 18903 86882 3857641  38.6 Italy   Both  
# ℹ 1,718 more rows
# ℹ 1 more variable: Area <fct>

On joint ensuite les deux tables grâce à la fonction merge vue dans le DM précédent.

all_cohorte_1890 <- merge(moment_1890, cohorte_1890, by=c("Age",'Gender', "Country")) |> rename("qx.1890"=qx.x, "qx.reel"=qx.y)

tail(all_cohorte_1890)

     Age Gender         Country Year.x    mx.x qx.1890 ax.x lx.x dx.x Lx.x Tx.x
1360  90 Female          Sweden   1890 0.32119 0.27675  0.5 2611  723 2249 6974
1361  90   Male England & Wales   1890 0.35411 0.30085  0.5  599  180  509 1496
1362  90   Male          France   1890 0.38924 0.32582  0.5  557  181  466 1296
1363  90   Male           Italy   1890 0.36321 0.30738  0.5  712  219  602 1714
1364  90   Male     Netherlands   1890 0.37671 0.31700  0.5  712  226  600 1695
1365  90   Male          Sweden   1890 0.35181 0.29919  0.5 1547  463 1315 3856
     ex.x Area.x Year.y    mx.y qx.reel ax.y  lx.y dx.y  Lx.y  Tx.y ex.y Area.y
1360 2.67     NE   1980 0.19743 0.17969  0.5 17541 3152 15965 66839 3.81     NE
1361 2.50     NE   1980 0.26902 0.23713  0.5  4673 1108  4119 14806 3.17     NE
1362 2.33     SE   1980 0.25406 0.22542  0.5  6067 1368  5383 19512 3.22     SE
1363 2.41     SE   1980 0.27562 0.24224  0.5  5325 1290  4680 16325 3.07     SE
1364 2.38     NE   1980 0.23223 0.20807  0.5  7330 1525  6568 25795 3.52     NE
1365 2.49     NE   1980 0.27766 0.24381  0.5  7063 1722  6202 22137 3.13     NE

Pour mettre en évidence la différence entre les deux quotients de mortalité, on peut les tracer pour chaque pays et les séparer en fonction du genre. On va d’abord transformer les colonnes qx.1890 et qx.reel en ligne.

all_cohorte_1890_long <- all_cohorte_1890 |>
  pivot_longer(cols=c("qx.1890", "qx.reel"), names_to="Qx", values_to = "valeur.qx")

all_cohorte_1890_long

# A tibble: 2,730 × 23
     Age Gender Country Year.x  mx.x  ax.x  lx.x  dx.x  Lx.x   Tx.x  ex.x Area.x
   <int> <fct>  <fct>    <int> <dbl> <dbl> <int> <int> <int>  <int> <dbl> <fct> 
 1     0 Both   Englan…   1890 0.162  0.31   1e5 14543 89904 4.47e6  44.7 NE    
 2     0 Both   Englan…   1890 0.162  0.31   1e5 14543 89904 4.47e6  44.7 NE    
 3     0 Both   France    1890 0.180  0.31   1e5 15993 88898 4.34e6  43.4 SE    
 4     0 Both   France    1890 0.180  0.31   1e5 15993 88898 4.34e6  43.4 SE    
 5     0 Both   Italy     1890 0.218  0.31   1e5 18903 86882 3.86e6  38.6 SE    
 6     0 Both   Italy     1890 0.218  0.31   1e5 18903 86882 3.86e6  38.6 SE    
 7     0 Both   Nether…   1890 0.208  0.31   1e5 18183 87377 4.44e6  44.4 NE    
 8     0 Both   Nether…   1890 0.208  0.31   1e5 18183 87377 4.44e6  44.4 NE    
 9     0 Both   Sweden    1890 0.112  0.31   1e5 10435 92755 5.04e6  50.4 NE    
10     0 Both   Sweden    1890 0.112  0.31   1e5 10435 92755 5.04e6  50.4 NE    
# ℹ 2,720 more rows
# ℹ 11 more variables: Year.y <int>, mx.y <dbl>, ax.y <dbl>, lx.y <int>,
#   dx.y <int>, Lx.y <int>, Tx.y <int>, ex.y <dbl>, Area.y <fct>, Qx <chr>,
#   valeur.qx <dbl>

Pour la France :

FR_1890 <- all_cohorte_1890_long |> filter(Country=='France')
FR_1890

# A tibble: 546 × 23
     Age Gender Country Year.x   mx.x  ax.x   lx.x  dx.x  Lx.x    Tx.x  ex.x
   <int> <fct>  <fct>    <int>  <dbl> <dbl>  <int> <int> <int>   <int> <dbl>
 1     0 Both   France    1890 0.180   0.31 100000 15993 88898 4343367  43.4
 2     0 Both   France    1890 0.180   0.31 100000 15993 88898 4343367  43.4
 3     0 Female France    1890 0.162   0.31 100000 14618 89974 4483572  44.8
 4     0 Female France    1890 0.162   0.31 100000 14618 89974 4483572  44.8
 5     0 Male   France    1890 0.197   0.3  100000 17298 87877 4210587  42.1
 6     0 Male   France    1890 0.197   0.3  100000 17298 87877 4210587  42.1
 7     1 Both   France    1890 0.0551  0.5   84007  4503 81755 4254469  50.6
 8     1 Both   France    1890 0.0551  0.5   84007  4503 81755 4254469  50.6
 9     1 Female France    1890 0.0534  0.5   85382  4438 83163 4393599  51.5
10     1 Female France    1890 0.0534  0.5   85382  4438 83163 4393599  51.5
# ℹ 536 more rows
# ℹ 12 more variables: Area.x <fct>, Year.y <int>, mx.y <dbl>, ax.y <dbl>,
#   lx.y <int>, dx.y <int>, Lx.y <int>, Tx.y <int>, ex.y <dbl>, Area.y <fct>,
#   Qx <chr>, valeur.qx <dbl>

g_france <- ggplot(FR_1890) +
  aes(x = Age, y =valeur.qx, group = Qx, color = Qx) +
  geom_line(aes(color=Qx))+
  facet_grid(Gender ~ Country, scales = "free") +
  labs(title = "Comparaison des quotients de mortalité des tables du moment \nde 1890 et des quotients de mortalité effectivement subis pour la France",
       x = "Age",
       y = "Valeur du quotient de mortalité",
       color = "Quotients de mortalité") +
  theme(plot.title = element_text(size = 12, face = "bold", hjust = 0.5),
        legend.position = "bottom",
        axis.title.x = element_text(size = 8, face = "bold", hjust = 0.5),
        axis.title.y = element_text(size = 8, face = "bold", hjust = 0.5))

g_france

Pour l’Italie :

IT_1890 <- all_cohorte_1890_long |> filter(Country=='Italy')
IT_1890

# A tibble: 546 × 23
     Age Gender Country Year.x   mx.x  ax.x   lx.x  dx.x  Lx.x    Tx.x  ex.x
   <int> <fct>  <fct>    <int>  <dbl> <dbl>  <int> <int> <int>   <int> <dbl>
 1     0 Both   Italy     1890 0.218   0.31 100000 18903 86882 3857641  38.6
 2     0 Both   Italy     1890 0.218   0.31 100000 18903 86882 3857641  38.6
 3     0 Female Italy     1890 0.205   0.31 100000 17969 87675 3861739  38.6
 4     0 Female Italy     1890 0.205   0.31 100000 17969 87675 3861739  38.6
 5     0 Male   Italy     1890 0.230   0.3  100000 19781 86136 3855662  38.6
 6     0 Male   Italy     1890 0.230   0.3  100000 19781 86136 3855662  38.6
 7     1 Both   Italy     1890 0.0756  0.5   81097  5909 78142 3770759  46.5
 8     1 Both   Italy     1890 0.0756  0.5   81097  5909 78142 3770759  46.5
 9     1 Female Italy     1890 0.0770  0.5   82031  6080 78991 3774064  46.0
10     1 Female Italy     1890 0.0770  0.5   82031  6080 78991 3774064  46.0
# ℹ 536 more rows
# ℹ 12 more variables: Area.x <fct>, Year.y <int>, mx.y <dbl>, ax.y <dbl>,
#   lx.y <int>, dx.y <int>, Lx.y <int>, Tx.y <int>, ex.y <dbl>, Area.y <fct>,
#   Qx <chr>, valeur.qx <dbl>

g_italie <- ggplot(IT_1890) +
  aes(x = Age, y =valeur.qx, group = Qx, color = Qx) +
  geom_line(aes(color=Qx))+
  facet_grid(Gender ~ Country, scales = "free") +
  labs(title = "Comparaison des quotients de mortalité des tables du moment \nde 1890 et des quotients de mortalité effectivement subis pour l'Italie",
       x = "Age",
       y = "Valeur du quotient de mortalité",
       color = "Quotients de mortalité") +
  theme(plot.title = element_text(size = 12, face = "bold", hjust = 0.5),
        legend.position = "bottom",
        axis.title.x = element_text(size = 8, face = "bold", hjust = 0.5),
        axis.title.y = element_text(size = 8, face = "bold", hjust = 0.5))

g_italie

Pour l’Angleterre et Pays de Galles :

EW_1890 <- all_cohorte_1890_long |> filter(Country=='England & Wales')
EW_1890

# A tibble: 546 × 23
     Age Gender Country      Year.x   mx.x  ax.x   lx.x  dx.x  Lx.x   Tx.x  ex.x
   <int> <fct>  <fct>         <int>  <dbl> <dbl>  <int> <int> <int>  <int> <dbl>
 1     0 Both   England & W…   1890 0.162   0.31 100000 14543 89904 4.47e6  44.7
 2     0 Both   England & W…   1890 0.162   0.31 100000 14543 89904 4.47e6  44.7
 3     0 Female England & W…   1890 0.145   0.31 100000 13185 90957 4.65e6  46.5
 4     0 Female England & W…   1890 0.145   0.31 100000 13185 90957 4.65e6  46.5
 5     0 Male   England & W…   1890 0.178   0.3  100000 15845 88895 4.30e6  43.0
 6     0 Male   England & W…   1890 0.178   0.3  100000 15845 88895 4.30e6  43.0
 7     1 Both   England & W…   1890 0.0582  0.5   85457  4835 83040 4.38e6  51.3
 8     1 Both   England & W…   1890 0.0582  0.5   85457  4835 83040 4.38e6  51.3
 9     1 Female England & W…   1890 0.0564  0.5   86815  4761 84435 4.56e6  52.6
10     1 Female England & W…   1890 0.0564  0.5   86815  4761 84435 4.56e6  52.6
# ℹ 536 more rows
# ℹ 12 more variables: Area.x <fct>, Year.y <int>, mx.y <dbl>, ax.y <dbl>,
#   lx.y <int>, dx.y <int>, Lx.y <int>, Tx.y <int>, ex.y <dbl>, Area.y <fct>,
#   Qx <chr>, valeur.qx <dbl>

g_enwa <- ggplot(EW_1890) +
  aes(x = Age, y =valeur.qx, group = Qx, color = Qx) +
  geom_line(aes(color=Qx))+
  facet_grid(Gender ~ Country, scales = "free") +
  labs(title = "Comparaison des quotients de mortalité des tables du moment \nde 1890 et des quotients de mortalité effectivement subis pour l'Angleterre et Pays de Gales",
       x = "Age",
       y = "Valeur du quotient de mortalité",
       color = "Quotients de mortalité") +
  theme(plot.title = element_text(size = 12, face = "bold", hjust = 0.5),
        legend.position = "bottom",
        axis.title.x = element_text(size = 8, face = "bold", hjust = 0.5),
        axis.title.y = element_text(size = 8, face = "bold", hjust = 0.5))

g_enwa

Pour les Pays-Bas :

NETH_1890 <- all_cohorte_1890_long |> filter(Country=='Netherlands')
NETH_1890

# A tibble: 546 × 23
     Age Gender Country     Year.x   mx.x  ax.x   lx.x  dx.x  Lx.x    Tx.x  ex.x
   <int> <fct>  <fct>        <int>  <dbl> <dbl>  <int> <int> <int>   <int> <dbl>
 1     0 Both   Netherlands   1890 0.208   0.31 100000 18183 87377 4441719  44.4
 2     0 Both   Netherlands   1890 0.208   0.31 100000 18183 87377 4441719  44.4
 3     0 Female Netherlands   1890 0.187   0.31 100000 16562 88640 4576372  45.8
 4     0 Female Netherlands   1890 0.187   0.31 100000 16562 88640 4576372  45.8
 5     0 Male   Netherlands   1890 0.229   0.3  100000 19710 86186 4312684  43.1
 6     0 Male   Netherlands   1890 0.229   0.3  100000 19710 86186 4312684  43.1
 7     1 Both   Netherlands   1890 0.0548  0.5   81817  4365 79634 4354342  53.2
 8     1 Both   Netherlands   1890 0.0548  0.5   81817  4365 79634 4354342  53.2
 9     1 Female Netherlands   1890 0.0540  0.5   83438  4388 81244 4487732  53.8
10     1 Female Netherlands   1890 0.0540  0.5   83438  4388 81244 4487732  53.8
# ℹ 536 more rows
# ℹ 12 more variables: Area.x <fct>, Year.y <int>, mx.y <dbl>, ax.y <dbl>,
#   lx.y <int>, dx.y <int>, Lx.y <int>, Tx.y <int>, ex.y <dbl>, Area.y <fct>,
#   Qx <chr>, valeur.qx <dbl>

g_neth <- ggplot(NETH_1890) +
  aes(x = Age, y =valeur.qx, group = Qx, color = Qx) +
  geom_line(aes(color=Qx))+
  facet_grid(Gender ~ Country, scales = "free") +
  labs(title = "Comparaison des quotients de mortalité des tables du moment \nde 1890 et des quotients de mortalité effectivement subis pour les Pays-Bas",
       x = "Age",
       y = "Valeur du quotient de mortalité",
       color = "Quotients de mortalité") +
  theme(plot.title = element_text(size = 12, face = "bold", hjust = 0.5),
        legend.position = "bottom",
        axis.title.x = element_text(size = 8, face = "bold", hjust = 0.5),
        axis.title.y = element_text(size = 8, face = "bold", hjust = 0.5))

g_neth

Pour la Suède :

SWE_1890 <- all_cohorte_1890_long |> filter(Country=='Sweden')
SWE_1890

# A tibble: 546 × 23
     Age Gender Country Year.x   mx.x  ax.x   lx.x  dx.x  Lx.x    Tx.x  ex.x
   <int> <fct>  <fct>    <int>  <dbl> <dbl>  <int> <int> <int>   <int> <dbl>
 1     0 Both   Sweden    1890 0.112   0.31 100000 10435 92755 5044007  50.4
 2     0 Both   Sweden    1890 0.112   0.31 100000 10435 92755 5044007  50.4
 3     0 Female Sweden    1890 0.101   0.31 100000  9408 93547 5177133  51.8
 4     0 Female Sweden    1890 0.101   0.31 100000  9408 93547 5177133  51.8
 5     0 Male   Sweden    1890 0.124   0.3  100000 11412 92002 4908335  49.1
 6     0 Male   Sweden    1890 0.124   0.3  100000 11412 92002 4908335  49.1
 7     1 Both   Sweden    1890 0.0337  0.5   89565  2967 88082 4951252  55.3
 8     1 Both   Sweden    1890 0.0337  0.5   89565  2967 88082 4951252  55.3
 9     1 Female Sweden    1890 0.0334  0.5   90592  2974 89105 5083586  56.1
10     1 Female Sweden    1890 0.0334  0.5   90592  2974 89105 5083586  56.1
# ℹ 536 more rows
# ℹ 12 more variables: Area.x <fct>, Year.y <int>, mx.y <dbl>, ax.y <dbl>,
#   lx.y <int>, dx.y <int>, Lx.y <int>, Tx.y <int>, ex.y <dbl>, Area.y <fct>,
#   Qx <chr>, valeur.qx <dbl>

g_suede <- ggplot(SWE_1890) +
  aes(x = Age, y =valeur.qx, group = Qx, color = Qx) +
  geom_line(aes(color=Qx))+
  facet_grid(Gender ~ Country, scales = "free") +
  labs(title = "Comparaison des quotients de mortalité des tables du moment \nde 1890 et des quotients de mortalité effectivement subis pour la Suède",
       x = "Age",
       y = "Valeur du quotient de mortalité",
       color = "Quotients de mortalité") +
  theme(plot.title = element_text(size = 12, face = "bold", hjust = 0.5),
        legend.position = "bottom",
        axis.title.x = element_text(size = 8, face = "bold", hjust = 0.5),
        axis.title.y = element_text(size = 8, face = "bold", hjust = 0.5))

g_suede

Commentaire :

Les courbes du quotient de mortalité de la table de moment et de la table de génération sont identiques entre 0 et 50 ans excepté vers 25 pour pratiquement tous les pays.

On observe deux différences : un pic de la courbe du quotient de mortalité réel vers 25 ans et la courbe du quotient de mortalité réel est en dessous de celle des quotients de mortalité tirés de la table de moment après 50 ans.

Pic vers 25 ans : On observe un pic (plus ou moins prononcé selon le sexe et le pays) de la courbe du quotient réel vers l’âge de 25 ans, ce qui correspond aux années 1914 (1890+24) et 1918 (1890+28) et donc à la première guerre mondiale. Les personnes, particulièrement les hommes, nées en 1890 à l’âge de 25 ans sont confrontées à de nombreux risques dus à la première guerre mondiale. La France, l’Italie, l’Angleterre et les Pays-Bas ont un pic plus prononcé puisqu’ils sont des pays qui ont été au coeur de la guerre (le front est en France). Les hommes sont plus mort entre 24 et 28 ans que ce qui était prévu en 1890 vu que la table de moment de 1890 ne tenait pas compte la première guerre mondiale.

Après 50 ans : Pour tous les pays la courbe du quotient de mortalité réel après 50 ans passe en dessous de celle du quotient de mortalité de la table de moment. Le risque de mourir après 50 ans a diminué par rapport à 1890.